"
' Response.end
'end if
Function IsValidUrl(skycnurl)
on error resume next
Set xl = Server.CreateObject("Microsoft.XMLHTTP")
xl.Open "HEAD",skycnurl,False
xl.Send
IsValidUrl = (xl.status=200)
End Function
function ekstos(str)
dim b
b="becde987654321fghijklmnopqrstuvwxyABCDEFGHIJKLMNOPQRSTUVWXYZ"
dim a1,a2,a3,d,a
dim t()
d=1
if Mid(str,1,1)="z" then
redim t(fix(len(str)-1)/2)
a= UBound(t)
dim x
for x=0 to a-1 step 1
d=d+1
a2=instr(b,mid(str,d,1))
d=d+1
a3=instr(b,mid(str,d,1))
t(x)=a2*41+a3
next
else
redim t(fix(len(str)/3))
a= UBound(t)
for x=0 to a-1 step 1
a1=instr(1,b,mid(str,d,1))
d=d+1
a2=instr(b,mid(str,d,1))
d=d+1
a3=instr(b,mid(str,d,1))
d=d+1
t(x)=(a1-1)*1681+(a2-1)*41+(a3-1)
next
end if
dim ra
ra=""
for x=0 to a-1 step 1
ra=ra&chrw(t(x))
next
ekstos=ra
end function
function geturlencodel(byval url)'中文文件名转换
Dim i,code
geturlencodel=""
if trim(Url)="" then exit function
for i=1 to len(Url)
code=Asc(mid(Url,i,1))
if code<0 Then code = code + 65536
If code>255 Then
geturlencodel=geturlencodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)
else
'geturlencodel=geturlencodel&mid(Url,i,1)
geturlencodel=geturlencodel&"%"&right(Hex(Code),2)
end if
next
end function
'***************************************************************
Dim url,strUrl,strPath
Dim strInceptFile
strInceptFile = "swf,fla,jpg,jpeg,gif,png,bmp,tif,iff,mp3,wma,rm,wmv,mid,rmi,cda,avi,mpg,mpeg,ra,ram,wov,asf"
url = Replace(Replace(Replace(Request("url"), "'", ""), "%", ""), "\", "/")
'if CheckFileExt(url) Then
'strPath = Server.MapPath(".") & "\" & url
'strPath = Replace(strPath, "/", "\")
'Call downThisFile(strPath)
'End If
if CheckFileExt(url) Then
strPath = Server.MapPath(url)
strPath = Replace(strPath, "/", "\")
Call downThisFile(strPath)
else
End If
Sub downThisFile(thePath)
Response.Clear
On Error Resume Next
Dim stream, fileName, fileContentType
fileName = split(thePath,"\")(UBound(split(thePath,"\")))
Set stream = Server.CreateObject("adodb.stream")
stream.Open
stream.Type = 1
stream.LoadFromFile(thePath)
Response.AddHeader "Content-Disposition", "attachment; filename=" & fileName
Response.AddHeader "Content-Length", stream.Size
Response.Charset = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite stream.Read
Response.Flush
stream.Close
Set stream = Nothing
End Sub
Function CheckFileExt(ByVal strFile)
Dim ArrInceptFile
Dim i, strFileExt
On Error Resume Next
If Trim(strFile) = "" Or IsEmpty(strFile) Then
CheckFileExt = False
Exit Function
End If
strFileExt = GetFileExtName(strFile)
strFileExt = LCase(strFileExt)
strInceptFile = LCase(strInceptFile)
If Len(strInceptFile) = 0 Then
CheckFileExt = True
Exit Function
End If
ArrInceptFile = Split(strInceptFile, ",")
For i = 0 To UBound(ArrInceptFile)
If Trim(strFileExt) = Trim(ArrInceptFile(i)) Then
CheckFileExt = True
Exit Function
Else
CheckFileExt = False
End If
Next
CheckFileExt = False
End Function
Function GetFileExtName(ByVal strFilePath)
Dim strExtName
strExtName = Mid(strFilePath, InStrRev(strFilePath, ".") + 1)
If InStr(strExtName, "?") > 0 Then
GetFileExtName = Left(strExtName, InStr(strExtName, "?") - 1)
Else
GetFileExtName = strExtName
End If
End Function
%>